home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / modula2 / hk_lib / def_mod / machine.mod < prev    next >
Encoding:
Modula Implementation  |  1994-09-22  |  7.7 KB  |  218 lines
  1. IMPLEMENTATION MODULE  MACHINE;
  2.  
  3. (*****************************************************************************)
  4. (* Um die Interruptmaske der CPU manipulieren zu koennen, wurde ein 'unsau-  *)
  5. (* berer' Weg beschritten: Da bekannt ist, welche Register beim Aufruf einer *)
  6. (* XBIOS-Funktion gerettet werden, und auch ueber eine Systemvariable bekannt*)
  7. (* ist, an welcher Stelle sie gespeichert sind, kann das beim Uebergang in   *)
  8. (* den Supervisormodus gerettete Statusregister manipuliert werden.          *)
  9. (* Bei der Rueckkehr aus der Ausnahmebehandlung wird dann dieses veraenderte *)
  10. (* Statusregister in das SR der CPU geschrieben.                             *)
  11. (* Diese Vorgehensweise haengt natuerlich davon ab, dass die Anzahl der ge-  *)
  12. (* retteten Register sich nicht veraendert; sollte dies bei einer spaeteren  *)
  13. (* TOS-Version der Fall sein, muss der Offset fuer das Statusregister ent-   *)
  14. (* sprechend geaendert werden.                                               *)
  15. (*                                                                           *)
  16. (* Eine andere Moeglichkeit waere es, je nach momentanem CPU-Modus direkt    *)
  17. (* das Statusregister zu manipulieren, oder erst in den Supervisormodus zu   *)
  18. (* schalten, das SR zu manipulieren, und danach wieder in den User-Modus zu  *)
  19. (* gehen. Der momentane CPU-Modus muesste auf jeden Fall vorher abgefragt    *)
  20. (* werden, denn waere die CPU im Supervisormodus beim Aufruf einer der beiden*)
  21. (* Funktionen, so wuerde das unbedingte "SuperOff" am Ende der Prozedur den  *)
  22. (* User-Modus einschalten. Neben dem unerwuenschten Nebeneffekt, gaebe das   *)
  23. (* evtl. Stacksalat, da der Moduswechsel auf unterschiedlichen Prozedurebenen*)
  24. (* geschaehe ( ob's tatsaechlich Aerger mit dem Stack gibt, habe ich aller-  *)
  25. (* dings nicht ausprobiert ).                                                *)
  26. (*___________________________________________________________________________*)
  27. (*  09-Feb-90 , hk  Beginn                                                   *)
  28. (*  11-Feb-90 , hk  erste Version                                            *)
  29. (*  12-Feb-90 , hk  "BREAKPOINT" neu                                         *)
  30. (*  05-Mae-90 , hk                                                           *)
  31. (*     Traps aus "TRAPdefs" importiert,                                      *)
  32. (*     die Adressparameter in "Read/WriteSysMem" als LONGCARD, damit auch    *)
  33. (*     sedezimale Konstanten moeglich sind.                                  *)
  34. (*****************************************************************************)
  35.  
  36. FROM  SYSTEM    IMPORT  (* TYPE *) BYTE, ADDRESS,
  37.                         (* PROC *) VAL, REG, ADR, INLINE;
  38.  
  39. FROM  TRAPdefs  IMPORT  (* CONST*) d0,
  40.                         (* PROC *) XBIOS1l, GEMDOS1l;
  41.  
  42. FROM  MEMORY    IMPORT  (* PROC *) CopySmallMem;
  43.  
  44.  
  45. (*===========================================================================*)
  46. (*====   L O K A L   ========================================================*)
  47.  
  48. CONST  Supexec = 38;
  49.        Super   = 32;
  50.  
  51. VAR  quelle,
  52.      ziel   : ADDRESS;
  53.      laenge : CARDINAL;
  54.  
  55.      stack  : LONGCARD;
  56.  
  57. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  58.  
  59. PROCEDURE  Copy;
  60. (*T*)
  61.  BEGIN
  62.    (* Da "Copy" parameterlos ist, kann sie mit XBIOS.Supexec
  63.     * im Supervisormodus ausgefuehrt werden.
  64.     *)
  65.    CopySmallMem( quelle, ziel, laenge );
  66.  END  Copy;
  67.  
  68.  
  69. (*===========================================================================*)
  70.  
  71.  
  72. PROCEDURE  ReadSysMem  ((* EIN/ -- *)     adr  : LONGCARD;
  73.                         (* -- /AUS *) VAR wert : ARRAY OF BYTE );
  74. (*T*)
  75.   BEGIN
  76.     (* Die Parameter fuer die Kopierfunktion muessen
  77.      * globalen Variablen zugewiesen werden, damit die
  78.      * parameterlose Prozedur "Copy", die sie an die
  79.      * eigentliche Kopierfunktion uebergibt, im Supervisor-
  80.      * modus mit 'Supexec' ausgefuehrt werden kann.
  81.      *)
  82.  
  83.     quelle := adr;
  84.     ziel   := ADR( wert );
  85.     laenge := HIGH( wert ) + 1;
  86.  
  87.     XBIOS1l( ADR( Copy ), Supexec );
  88.   END  ReadSysMem;
  89.  
  90. (*---------------------------------------------------------------------------*)
  91.  
  92.   PROCEDURE  WriteSysMem ((* EIN/ -- *) adr  : LONGCARD;
  93.                           (* EIN/ -- *) wert : ARRAY OF BYTE );
  94. (*T*)
  95.   BEGIN
  96.     quelle := ADR( wert );
  97.     ziel   := adr;
  98.     laenge := HIGH( wert ) + 1;
  99.  
  100.     XBIOS1l( ADR( Copy ), Supexec );
  101.   END  WriteSysMem;
  102.  
  103. (*---------------------------------------------------------------------------*)
  104.  
  105. PROCEDURE  CurrentCPUMode ( ): CPUMode;
  106. (*T*)
  107.   BEGIN
  108.     GEMDOS1l( 1D, Super );
  109.     RETURN( VAL( CPUMode, -REG( d0 )));
  110.   END  CurrentCPUMode;
  111.  
  112. (*---------------------------------------------------------------------------*)
  113.  
  114. PROCEDURE  SuperOn;
  115. (**)
  116.   BEGIN
  117.     IF  CurrentCPUMode() = USER  THEN
  118.       GEMDOS1l( 0D, Super );
  119.       stack := REG( d0 );
  120.       (* Der alte Wert des Supervisor-Stackpointers
  121.        * wird gemerkt, damit er beim Wechsel in den
  122.        * User-Modus wieder auf seinen alten Wert
  123.        * gesetzt werden kann.
  124.        *)
  125.     END;
  126.   END  SuperOn;
  127.  
  128. (*---------------------------------------------------------------------------*)
  129.  
  130. PROCEDURE  SuperOff;
  131. (**)
  132.   BEGIN
  133.     IF  CurrentCPUMode() = SUPERVISOR  THEN
  134.       GEMDOS1l( stack, Super );
  135.     END;
  136.   END  SuperOff;
  137.  
  138. (*---------------------------------------------------------------------------*)
  139.  
  140. PROCEDURE  CurrentIRLevel ( ): IRLevel;
  141. (*T*)
  142. (* Beim 68000 wuerde auch ein  'move sr, d0'  ausreichen, um an die
  143.    aktuelle Interruptmaske zu kommen, ist aber ein 68010/20 im Rechner,
  144.    kann der Befehl nur im Supervisormodus ausgefuehrt werden.
  145. *)
  146.   BEGIN
  147. (*
  148.     oldsr   EQU  10*4+4        ; Offset des SR im Registerpuffer
  149.     savptr  EQU  $4A2          ; Zeiger auf den Registerpuffer
  150.     irmsk   EQU  $0700
  151.  
  152.     Supexec EQU 38
  153.     Xbios   EQU 14
  154.     RETURN  EQU 12
  155.  
  156.     CurrentIRLevel:
  157.       pea     getir(pc)        ; Adresse der auszufuehrenden Prozedur
  158.       move.w  #Supexec, -(sp)  ; Prozedur im Supervisormodus ausfuehren
  159.       trap    #Xbios           ;
  160.       bra.s   ende             ; fertig
  161.  
  162.     getir:
  163.       movea.l savptr, a1       ; a1 -> Speicher fuer gerettete Register
  164.       move.w  oldsr(a1), d7    ; d7 := gerettetes Statusregister
  165.       andi.w  #irmsk, d7       ; d7 := IR-maske
  166.       lsr.w   #8, d7           ; als CARDINAL-Wert
  167.       move.b  d7, RETURN(a6)
  168.       rts
  169.  
  170.     ende:
  171. *)
  172.     INLINE( 487AH,000AH,3F3CH,0026H,4E4EH,6016H,2279H,0000H,04A2H );
  173.     INLINE( 3E29H,002CH,0247H,0700H,0E04FH,1D47H,000CH,4E75H );
  174.  
  175.   END  CurrentIRLevel;
  176.  
  177. (*---------------------------------------------------------------------------*)
  178.  
  179. PROCEDURE  SetIRLevel ((* EIN/ -- *) irlevel : IRLevel );
  180. (*T*)
  181.   BEGIN
  182. (*
  183.     oldsr   EQU  10*4+4
  184.     savptr  EQU  $4A2
  185.     expmsk  EQU  $0700
  186.  
  187.     Supexec EQU  38
  188.     Xbios   EQU  14
  189.     irlevel EQU  12
  190.  
  191.     SetIRLevel:
  192.       pea     setir(pc)
  193.       move.w  #Supexec, -(sp)
  194.       trap    #Xbios
  195.       bra.s   ende
  196.  
  197.     setir:
  198.       movea.l savptr, a1       ; a1 -> Speicher fuer gerettete Register
  199.       move.w  oldsr(a1), d0    ; d0 := gerettetes Statusregister
  200.       moveq   #0, d1           ; IR-Maske auf Wortlaenge
  201.       move.b  irlevel(a6), d1  ;
  202.       lsl.w   #8, d1           ; an die Position der IR-Maske im SR bringen
  203.       andi.w  #$FFFF-expmsk, d0; alte IR-Maske loeschen
  204.       or.w    d1, d0           ; und neue setzen
  205.       move.w  d0, oldsr(a1)    ; neue wird bei RTE gesetzt
  206.       rts
  207.  
  208.     ende:
  209. *)
  210.     INLINE( 487AH,000AH,3F3CH,0026H,4E4EH,601EH,2279H,0000H,04A2H );
  211.     INLINE( 3029H,002CH,7200H,122EH,000CH,0E149H,0240H,0F8FFH,8041H );
  212.     INLINE( 3340H,002CH,4E75H );
  213.  
  214.   END SetIRLevel;
  215.  
  216.  
  217. END  MACHINE.
  218.